(**
\parskip=6pt
\parindent=6pt

\newcount\pc
\pc=0

\def\p#1{
  \advance\pc by 1
  \noindent{\bf \the\pc. #1.}\quad
}

\def\pp{
  \advance\pc by 1
  \noindent{\bf \the\pc.}\quad
} 

\font\titlefont=cmr17 at 24pt

\hfill March 2009

{\titlefont \noindent texcaml 0.1}

\vskip 1cm
  
  texcaml is a literate programming tool for OCaml, using \TeX. It
  translates an OCaml source file enriched with special comments into
  a \TeX\ file containing both documentation and source code.

  The main functionality of texcaml is to remove pairs of "{\tt
  ({}**}" and "{\tt *{})}". Text in between is called a {\it doc
  comment} and directly included in the result, so any \TeX\ commands
  are o.k. here. For example,
  
  {\tt \noindent
  \phantom{}\quad\quad ({}** This function maps \$x\$ to \$x\^{}2\$:\ *{}) \hfill\break
  \phantom{}\quad\quad let sq x = x*x
  }

  will be typeset as:

  \noindent
  \phantom{}\quad\quad  This function maps $x$ to $x^2$:*)
(**\phantom{}\quad\quad*)let sq x = x*x
(** As you can see, besides removing the comment parentheses, texcaml
  also attempts to embellish the OCaml code: keywords are typeset in
  bold, and identifiers in italic. Furthermore some symbols, mostly
  infix operators, are replaced by nicer \TeX\ variants, e.g. "{\tt
  *}" is typeset as "$\times$".  For a complete list see the function
  {\it texify\_sym} below.

  Every line in the source file generates one line in the resulting
  \TeX\ file. This means that you can locate errors easily if \TeX
  complains: line numbers in the .ml file and the resulting .tex file
  are the same.

  Outside doc comments a "$\backslash$hfill$\backslash$break" is
  inserted between any two consecutive non-empty lines. Blanks are
  escaped (so that indentation works), except if they are the only
  contents of a line, or occur at its beginning and precede a doc
  comment.

  You can use texcaml with both plain \TeX\ and LaTeX. For \TeX,
  include {\tt (** "$\backslash$bye" *)} or {\tt (** "$\backslash$end"
*)} at the end.  For LaTeX you'll need {\tt (**
  $\backslash$documentclass$\{$...$\}$ *)}, {\tt (**
  $\backslash$begin$\{$document$\}$*)}, and{\tt (**
  $\backslash$end$\{$document$\}$*)} in the right
  places. Alternatively you can use {\tt $\backslash$input} or a
  similar command to include the results in another file.

  As you might already have guessed this document was processed by
  texcaml. We now turn to the documentation of texcaml's source
  code. You are encouraged to look at the sources of this file as an
  example.

  \bigskip
*)

open List
open Camlp4.PreCast
open Camlp4.Sig

(** \p{Auxiliary Functions} *)

let prefix s = String.sub s 0

let suffixr s i = String.sub s i (String.length s - i)


(** \p{Lexical translation} In a given string the following function
  substitutes special characters by their \TeX\ equivalents
  (cf. TeXbook pp 3,37,51).
*)

let texify =
  let subs = [(**
                \settabs 4 \columns 
                \+ \ \ \ \ *)	' ', "\\phantom{}\\ ";	(**\hfill&*)	'\n', "\\hfill\\break\n"; (**\hfill&*)	'\\', "$\\backslash$";	(**\hfill&*)	'&', "\\&";	(**\cr
\+ \ \ \ \ *)	'~',"\\~{}";	(**\hfill&*)	'_', "\\_";	(**\hfill&*)	'$', "\\$";	(**\hfill&*)	'^', "\\^{}";	(**\cr
\+ \ \ \ \ *)	'|', "$|$";	(**\hfill&*)	'>', "$>$";	(**\hfill&*)	'<', "$<$";	(**\hfill&*)	'%', "\\%";	(**\cr
\+ \ \ \ \ *)	'{', "$\\{$";	(**\hfill&*)	'}', "$\\}$"	 ]	(**\cr
*)in
  let rec texify s = function
  | -1 -> s
  | i ->
    texify
      (try
         let si' = List.assoc s.[i] subs in
         prefix s i ^ si' ^ suffixr s (i+1)
       with
         Not_found -> s)
      (i - 1) in
  fun s -> texify s (String.length s - 1)
 
(** Some symbols, mostly infix operators, are mapped to special \TeX\ symbols. *)

let texify_sym = function (**
\settabs 2 \columns 
\+*)| "->" -> "$\\rightarrow$"	(** \cr
\smallskip
\settabs 2 \columns 
\+*)| "=" -> (**(* $=$ *)*) "$\\,=$"	(**\hfill&*)| "<>" -> (**(* $\neq$ *)*) "$\\,\\neq$" 	(**\cr
\+*)| "<" -> (**(* $<$ *)*) "$\\,<$"	(**\hfill&*)| ">" -> (**(* $>$ *)*) "$\\,>$"	(**\cr
\+*)| "<=" -> (**(* $\le$ *)*) "$\\,\\le$" 	(**\hfill&*)| ">=" -> (**(* $\ge$ *)*) "$\\,\\ge$" 	(**\cr
\+*)| "==" -> (**(* $\equiv$ *)*) "$\\,\\equiv$"	(**\hfill&*)| "!=" -> (**(* $\not\equiv$ *)*) "$\\,\not\\equiv$"	(** \cr
\smallskip
\settabs 2 \columns 
\+*)| "&&" -> (**(* $\land$  *)*) "$\\,\\land$"	(**\hfill&*)| "||" -> (**(* $\lor$ *)*) "$\\,\\lor$"	(** \cr
\smallskip
\settabs 2 \columns 
\+*)| "+" -> (**(* $+$ *)*) "$\\,+$"	(**\hfill&*)| "-" -> (**(* $-$ *)*) "$\\,-$"	(**\cr
\+*)| "*" -> (**(* $\times$ *)*) "$\\,\\times$"	(**\hfill&*)| "/" -> (**(* $/$ *)*) "$\\,/$"	(**\cr
\+*)| "~-" -> (**(* $\tilde-$ *)*) "$\\tilde-$"	(**\cr
\smallskip
\settabs 2 \columns 
\+*)| "+." -> (**(* $\dot+$ *)*) "$\\,\\dot+$"	(**\hfill&*)| "-." -> (**(* $\dot-$ *)*) "$\\,\\dot-$"	(**\cr
\+*)| "*." -> (**(* $\dot\times$ *)*) "$\\,\\dot\\times$"	(**\hfill&*)| "/." -> (**(* $\dot/$ *)*) "$$\\,\\dot/$"	(**\cr
\+*)| "~-." -> (**(* $\tilde-.$ *)*) "$\\tilde-.$"	(**\hfill&*)| "**" -> (**(* $**$ *)*) "$\\,**$"	(**\cr
\smallskip
\settabs 2 \columns 
\+*)| "^" -> (**(* \^{} *)*) "$\\,$\\^{}$\\,$"	(**\hfill&*)| "@" -> (**(* $\ddagger$ *)*) "$\\,\\ddagger$"	(** \cr
\+*)| ":=" -> (**(* $\mathrel{\mathop:}=$ *)*) "$\\mathrel{\\mathop:}=$"	(**\hfill&*)| "~~" -> (**(* $\neg$ *)*) "$\\neg$"	(** \cr
\smallskip
\settabs 2 \columns 
\+*)| s -> texify s (**\cr*)


(**\p{Keywords} OCaml keywords. (TODO Obtain this definition from
  camlp4)
*)

let is_keyword s = List.mem s [
  "and"; "as"; "assert"; "asr"; "begin"; "class"; "constraint"; "do";
  "done"; "downto"; "else"; "end"; "exception"; "external"; "false";
  "for"; "fun"; "function"; "functor"; "if"; "in"; "include";
  "inherit"; "initializer"; "land"; "lazy"; "let"; "lor"; "lsl"; "lsr";
  "lxor"; "match"; "method"; "mod"; "module"; "mutable"; "new";
  "object"; "of"; "open"; "or"; "parser"; "private"; "rec"; "sig";
  "struct"; "then"; "to"; "true"; "try"; "type"; "val"; "virtual";
  "when"; "while"; "with" ]

(** \p{The main program} *)

let () =
match Sys.argv with
| [| _; src_fn |] ->
  let src = open_in src_fn in
  let out = open_out (src_fn ^ ".tex") in

  let tokens = Lexer.mk () (Lexer.Loc.mk src_fn) (Stream.of_channel src) in

        (** Since sometimes we'll need to look backward in the stream
          the last two tokens are always kept in this reference. *)
  let last_two = ref (NEWLINE, NEWLINE) in

  let is_doc_comment c = c.[2] = '*' && String.length c >= 5 in

        (** This function converts the token {\it t} from the input
          stream into a bit of \TeX\ and writes it to the output
          file. It is going to be applied to each token. *)

  let translate_token (t,_) = output_string out
    (match t with

    | LIDENT "_" -> "$\\underline{\\phantom{a}}$"

    | LIDENT s | UIDENT s when is_keyword s -> "{\\bf " ^ texify s ^ "}"
    | LIDENT s | UIDENT s -> "{\\it " ^ texify s ^ "}" 

    | STRING (_,s) -> "\"" ^ texify s ^ "\""

    | CHAR (_,s) -> "'" ^ texify s ^ "'"

    | SYMBOL s -> texify_sym s

    | BLANKS s ->
      (match snd !last_two, Stream.peek tokens with 
      | NEWLINE, Some (COMMENT c, _) when is_doc_comment c -> s
      | NEWLINE, Some ((NEWLINE|EOI), _) -> s
      | _ -> texify s)

    | NEWLINE ->
      let next_two = map fst (Stream.npeek 2 tokens) in
      let this_empty = 
        match !last_two with
        | (_, NEWLINE)
        | (NEWLINE, BLANKS _) -> true
        | _ -> false in
      let next_empty =
        match next_two with
        | [ (NEWLINE|EOI); _ ]
        | [ BLANKS _; (NEWLINE|EOI) ] -> true 
        | _ -> false in
        (if this_empty || next_empty then "" else "\\hfill\\break") ^ 
        (if Stream.count tokens > 0 then "\n" else "") ^
        (if this_empty && not next_empty &&
           match next_two with
           | [ COMMENT c; _]
           | [ BLANKS _; COMMENT c] when is_doc_comment c -> false
           | _ -> true
         then "\\noindent\t"
         else "")
    | EOI -> close_out out; close_in src; exit 0

    | COMMENT c when is_doc_comment c -> String.sub c 3 (String.length c - 5)

         (** Everything else is escaped: *)

    | COMMENT s
    | ESCAPED_IDENT s
    | INT (_,s) | INT32 (_,s) | INT64 (_,s) | NATIVEINT (_,s) | FLOAT (_,s)
    | LABEL s
    | OPTLABEL s -> texify s
    | QUOTATION _ | ANTIQUOT (_,_)
    | LINE_DIRECTIVE (_,_) -> failwith "quotations are not yet supported"

    (** According to {\tt http://nicolaspouillard.fr/camlp4-changes.html},
      keyword recognition is now done after lexing, so why is there a
      KEYWORD constructor? *)

    | KEYWORD s -> failwith "KEYWORD token encountered");

    last_two := snd !last_two, t in

    (** In order to get indentation right, we begin with a virtual
      NEWLINE token, then proceed token by token. *)

    translate_token (NEWLINE, ());
    Stream.iter translate_token tokens

| _ -> prerr_endline ("Usage: " ^ Sys.argv.(0) ^ " <source file>")

(** \end *)
